VERSION 5.00
Begin VB.Form frmDOMRecurse 
   BackColor       =   &H00FFFFFF&
   Caption         =   "DOM Recursion"
   ClientHeight    =   4350
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   6375
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   4350
   ScaleWidth      =   6375
   Visible         =   0   'False
   WindowState     =   2  'Maximized
   Begin VB.ListBox lst 
      Appearance      =   0  'Flat
      Height          =   1080
      IntegralHeight  =   0   'False
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Visible         =   0   'False
      Width           =   2055
   End
   Begin VB.Menu mnuFileMenu 
      Caption         =   "&File"
      Begin VB.Menu mnuFileClose 
         Caption         =   "&Close"
      End
   End
Attribute VB_Name = "frmDOMRecurse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' DOMRecurse.frm    July 1999  contact markb@orionstudios.com
' Demonstrates recursive traversal of the Document Object Mode (DOM)
'   Recurse Method: displays HTML document tree from StartFromNode in a List Box.
' Includes routines to set ListBox tabs and horizontal scroll bar
' Uses  DOMRecurse.cls
'================================================================================
' Relevant nodeType values
Private Const ELEMENT_NODE = 1
Private Const TEXT_NODE = 3
' Module-level Variables
Private WithEvents mDOMRecurse As DOMRecurse    ' see mDOMRecurse_NodeEvent
Attribute mDOMRecurse.VB_VarHelpID = -1
' WinAPI Declarations
Private Const LB_SETTABSTOPS = &H192
Private Const LB_SETHORIZONTALEXTENT = &H194
Private Declare Function SendMessageByRef Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
Private Declare Function SendMessageByVal Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Sub Recurse(StartFromNode As MSHTML.IHTMLDOMNode)
    On Error GoTo Recurse_Error
'    Me.MousePointer = vbHourglass
    SetLBTabs lst.hWnd, 6, 12, 18, 24, 30, 36, 42, 48
    SetLBHScrollBar LBhWnd:=lst.hWnd, PixelWidth:=600
    Set mDOMRecurse = New DOMRecurse ' instantiate WithEvents module-level variable
    mDOMRecurse.RecurseFromNode StartNode:=StartFromNode
    Set mDOMRecurse = Nothing
Recurse_Exit:
'    Me.MousePointer = vbDefault
    lst.Visible = True
    Exit Sub
Recurse_Error:
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, Me.Name & ".Recurse"
    Resume Recurse_Exit
End Sub
Private Sub Form_Resize()
    On Error Resume Next
    lst.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
Private Sub mnuFileClose_Click()
    Unload Me
End Sub
Private Sub mDOMRecurse_NodeEvent(DOMNode As MSHTML.IHTMLDOMNode, ByVal Depth As Long)
' Event raised for each node encountered during recursive traversal.
' "Depth" is from the root node specified by the StartFromNode Property.
    Dim strNodeValue As String
    With DOMNode
        If .nodeType = TEXT_NODE Then
            strNodeValue = .nodeValue
        Else
            strNodeValue = .nodeName
        End If
    End With
    lst.AddItem String$(Depth, vbTab) & strNodeValue
End Sub
Public Sub SetLBTabs(LBhWnd As Long, ParamArray TabStops())
    On Error GoTo SetLBTabs_Exit
    Dim Tabs(0 To 7) As Long    ' Dialog units - approx Pixels*4
    Dim NumOfTabs As Long
    Dim IX As Long
    NumOfTabs = UBound(TabStops)
    For IX = 0 To NumOfTabs
        Tabs(IX) = TabStops(IX) * 4
    Next
    NumOfTabs = NumOfTabs + 1
    SendMessageByRef LBhWnd, LB_SETTABSTOPS, NumOfTabs, Tabs(0)
SetLBTabs_Exit:
End Sub
Public Sub SetLBHScrollBar(LBhWnd As Long, PixelWidth As Long)
    SendMessageByVal LBhWnd, LB_SETHORIZONTALEXTENT, PixelWidth, 0
End Sub